perm filename FOO.LSP[W81,JMC] blob sn#557653 filedate 1981-01-21 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(defun fp(x y) (fp1 (list x) y nil))
C00004 ENDMK
CāŠ—;
(defun fp(x y) (fp1 (list x) y nil))

(defun fp1 (u y p) (if
		    (null u)
		    'lose
		    (member (car u) p)
		    (fp1 (cdr u) y p)
		    (equal (car u) y)
		    (reverse (cons y p))
		    ((lambda (w) (if
				  (eq w 'lose)
				  (fp1 (cdr u) y p)
				  w))
		     (fp1 (ss (car u)) y (cons (car u) p)))))

(defun np (x y) ((lambda (w) (if
			      (eq (car w) 'lose)
			      'lose
			      (reverse w)))
		 (np1 (list x) y nil nil)))

(defun np1 (u y p s) (if
		      (null u)
		      (cons 'lose s)
		      (member (car u) s)
		      (np1 (cdr u) y p s)
		      (equal (car u) y)
		      (cons y p)
		      ((lambda (w) (if
				    (eq (car w) 'lose)
				    (np1 (cdr u) y p (cdr w))
				    w))
		       (np1 (ss (car u)) y (cons (car u) p) (cons (car u) s)))))

(defun ss (x) (if
	       (eq x 'a) '(b c d)
	       (eq x 'b) '(c)
	       (eq x 'c) '(e)
	       (eq x 'd) nil
	       (eq x 'e) nil))